home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / graphgem / gemsiii / boundvol.c < prev    next >
Encoding:
Text File  |  1992-03-16  |  12.7 KB  |  428 lines
  1. nstrate the GetImage and PutImage commands }
  2.  
  3. const
  4.   r  = 20;
  5.   StartX = 100;
  6.   StartY = 50;
  7.  
  8. var
  9.   CurPort : ViewPortType;
  10.  
  11. procedure MoveSaucer(var X, Y : integer; Width, Height : integer);
  12. var
  13.   Step : integer;
  14. begin
  15.   Step := Random(2*r);
  16.   if Odd(Step) then
  17.     Step := -Step;
  18.   X := X + Step;
  19.   Step := Random(r);
  20.   if Odd(Step) then
  21.     Step := -Step;
  22.   Y := Y + Step;
  23.  
  24.   { Make saucer bounce off viewport walls }
  25.   with CurPort do
  26.   begin
  27.     if (x1 + X + Width - 1 > x2) then
  28.       X := x2-x1 - Width + 1
  29.     else
  30.       if (X < 0) then
  31.         X := 0;
  32.     if (y1 + Y + Height - 1 > y2) then
  33.       Y := y2-y1 - Height + 1
  34.     else
  35.       if (Y < 0) then
  36.         Y := 0;
  37.   end;
  38. end; { MoveSaucer }
  39.  
  40. var
  41.   Pausetime : word;
  42.   Saucer    : pointer;
  43.   X, Y      : integer;
  44.   ulx, uly  : word;
  45.   lrx, lry  : word;
  46.   Size      : word;
  47.   I         : word;
  48. begin
  49.   ClearDevice;
  50.   FullPort;
  51.  
  52.   { PaintScreen }
  53.   ClearDevice;
  54.   MainWindow('GetImage / PutImage Demonstration');
  55.   StatusLine('Esc aborts or press a key...');
  56.   GetViewSettings(CurPort);
  57.  
  58.   { DrawSaucer }
  59.   Ellipse(StartX, StartY, 0, 360, r, (r div 3)+2);
  60.   Ellipse(StartX, StartY-4, 190, 357, r, r div 3);
  61.   Line(StartX+7, StartY-6, StartX+10, StartY-12);
  62.   Circle(StartX+10, StartY-12, 2);
  63.   Line(StartX-7, StartY-6, StartX-10, StartY-12);
  64.   Circle(StartX-10, StartY-12, 2);
  65.   SetFillStyle(SolidFill, MaxColor);
  66.   FloodFill(StartX+1, StartY+4, GetColor);
  67.  
  68.   { ReadSaucerImage }
  69.   ulx := StartX-(r+1);
  70.   uly := StartY-14;
  71.   lrx := StartX+(r+1);
  72.   lry := StartY+(r div 3)+3;
  73.  
  74.   Size := ImageSize(ulx, uly, lrx, lry);
  75.   GetMem(Saucer, Size);
  76.   GetImage(ulx, uly, lrx, lry, Saucer^);
  77. {  PutImage(ulx, uly, Saucer^, XORput);               { erase image }
  78.  
  79.   { Plot some "stars" }
  80.   for I := 1 to 1000 do
  81.      PutPixel(Random(MaxX), Random(MaxY), RandColor);
  82.   X := MaxX div 2;
  83.   Y := MaxY div 2;
  84.   PauseTime := 70;
  85.  
  86.   { Move the saucer around }
  87.   repeat
  88. {     PutImage(X, Y, Saucer^, XORput);                 { draw image }
  89.      Delay(PauseTime);
  90. {     PutImage(X, Y, Saucer^, XORput);                 { erase image }
  91.      MoveSaucer(X, Y, lrx - ulx + 1, lry - uly + 1);  { width/height }
  92.   until KeyPressed;
  93.   FreeMem(Saucer, size);
  94.   WaitToGo;
  95. end; { PutImagePlay }
  96.  
  97. procedure PolyPlay;
  98. { Draw random polygons with random fill styles on the screen }
  99. const
  100.   MaxPts = 5;
  101. type
  102.   PolygonType = array[1..MaxPts] of PointType;
  103. var
  104.   Poly : PolygonType;
  105.   I, Color : word;
  106. begin
  107.   MainWindow('FillPoly demonstration');
  108.   StatusLine('Esc aborts or press a key...');
  109.   repeat
  110.     Color := RandColor;
  111.     SetFillStyle(Random(11)+1, Color);
  112.     SetColor(Color);
  113.     for I := 1 to MaxPts do
  114.       with Poly[I] do
  115.       begin
  116.         X := Random(MaxX);
  117.         Y := Random(MaxY);
  118.       end;
  119.     FillPoly(MaxPts, Poly);
  120.   until KeyPressed;
  121.   WaitToGo;
  122. end; { PolyPlay }
  123.  
  124. procedure FillStylePlay;
  125. { Display all of the predefined fill styles available }
  126. var
  127.   Style    : word;
  128.   Width    : word;
  129.   Height   : word;
  130.   X, Y     : word;
  131.   I, J     : word;
  132.   ViewInfo : ViewPortType;
  133.  
  134. procedure DrawBox(X, Y : word);
  135. begin
  136.   SetFillStyle(Style, MaxColor);
  137.   with ViewInfo do
  138.     Bar(X, Y, X+Width, Y+Height);
  139.   Rectangle(X, Y, X+Width, Y+Height);
  140.   OutTextXY(X+(Width div 2), Y+Height+4, Int2Str(Style));
  141.   Inc(Style);
  142. end; { DrawBox }
  143.  
  144. begin
  145.   MainWindow('Pre-defined fill styles');
  146.   GetViewSettings(ViewInfo);
  147.   with ViewInfo do
  148.   begin
  149.     Width := 2 * ((x2+1) div 13);
  150.     Height := 2 * ((y2-10) div 10);
  151.   end;
  152.   X := Width div 2;
  153.   Y := Height div 2;
  154.   Style := 0;
  155.   for J := 1 to 3 do
  156.   begin
  157.     for I := 1 to 4 do
  158.     begin
  159.       DrawBox(X, Y);
  160.       Inc(X, (Width div 2) * 3);
  161.     end;
  162.     X := Width div 2;
  163.     Inc(Y, (Height div 2) * 3);
  164.   end;
  165.   SetTextJustify(LeftText, TopText);
  166.   WaitToGo;
  167. end; { FillStylePlay }
  168.  
  169. procedure FillPatternPlay;
  170. { Display some user defined fill patterns }
  171. const
  172.   Patterns : array[0..11] of FillPatternType = (
  173.   ($AA, $55, $AA, $55, $AA, $55, $AA, $55 üÖü üÖü  !BBäx!!!BBäx!BBäx"""DDêp""DDêp>"""BBääêp""!"BDäêêp>IÉÆ|      ° @≥î>00>><Dêx  !BBäx""DDêp&<"DDêê&22TTêêê$> $< @äêp>          ⁿBBBB<  @@Ç****DDDDDDDU¬U¬U¬U¬U¬U¬U¬▌w▌w▌w▌w▌w▌w▌w°°°≥■°°≥≥■≥≥■■°°°    ≤  ≤  ≤≤         °                     ≡≡≡≡≡≡≡≡≡≡≡≡≡≡       ;DDD;    $"Bdÿ>@@@>||>Ac]AAA1N"A""2,  `1NA"*III*<Bü üB<<BüüüB<A" \"QIE" < <BBBB  @@    ~ ?  @ÇB$$B ""A$$"AII6 üBr»$**IIII**ccregion.  The region is defined as any pixel of
  174.             OldColor which has a path of pixels of OldColor or NewColor
  175.             with sides touching back to the seed point, (XSeed, YSeed).
  176.             Therefore, only pixels of OldColor are modified and no other
  177.             information is changed.
  178.  
  179.             SEE ALSO
  180.  
  181.             DRWFILLBOX, DRWFILLCIRCLE, DRWFILLELLIPSE, FILLAREA,
  182.             FILLCONVEXPOLY, FILLPAGE, FILLPOLY, FILLSCREEN, FILLVIEW,
  183.             SETVIEW
  184.  
  185.             EXAMPL(HNxHHO$B<BBBB<$<BBBB<<BBBB<$BBBBBF:0BBBBF:$BBBF:B<""AAA""AAAAA"<B@@B<" <2\A">>xDDxDNDD <` <>BB= > <BBBB< BBBBF:2L\bBBBB&AaQIECA8$>""">0@@A>@@@ b$(. b$(*
  186.     $    $    $DDDDDDD¬U¬U¬U¬U¬U¬U¬Uw▌w▌w▌w▌w▌w▌w▌°°°⌠ⁿ°°⌠⌠ⁿ⌠⌠ⁿⁿ°°°    ≈  ≈  ≈≈         °                     ≡≡≡≡≡≡≡≡≡≡≡≡≡≡       7HH7"B\DBBRL~BB@@@@@@?R~!!~?DDDD8BBBB|@@Ç>P>III>"AA""AAA"Uw<DDDD86II6"EIQ"\ @@ "AAAAA> >     hH02L2L$$<H(,$<>>>>>>>         VMODE=VIDEOMODEGET
  187.             IF WHICHVGA = 0 THEN STOP
  188.             DUMMY=RES640
  189.             SETVIEW 100, 100, 539, 379
  190.             FILLVIEW 10
  191.             WHILE INKEY$ = ""
  192.             WEND
  193.             VIDEOMODESET VMODE
  194.             END
  195.  
  196.  
  197.  
  198.  
  199.  
  200.  
  201.  
  202.  
  203.  
  204.  
  205.  
  206.  
  207.  
  208.  
  209.  
  210.  
  211.                                                                          63
  212.  
  213.  
  214.  
  215.  
  216.  
  217.  
  218.           FONTGETINFO
  219.  
  220.             PROTOTYPE
  221.  
  222.             SUB FONTGETINFO (Width%, Height%)
  223.  
  224.             INPUT
  225.  
  226.             no input parameters
  227.     WEND
  228.             MOUSEEXIT
  229.             VIDEOMODESET VMODE
  230.             END
  231.  
  232.  
  233.  
  234.  
  235.  
  236.  
  237.  
  238.  
  239.  
  240.  
  241.  
  242.  
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  
  249.  
  250.  
  251.  
  252.  
  253.  
  254.  
  255.  
  256.  
  257.  
  258.  
  259.  
  260.  
  261.  
  262.  
  263.  
  264.  
  265.  
  266.  
  267.  
  268.  
  269.  
  270.  
  271.                                                                          86
  272.  
  273.  
  274.  
  275.  
  276.  
  277.  
  278.           MOUSECURSORDEFAULT
  279.  
  280.             PROTOTYPE
  281.  
  282.             SUB MOUSECURSORDEFAULT ()
  283.  
  284.             INPUT
  285.  
  286.             no input parameters
  287.  
  288.             OUTPUT
  289.  
  290.             no value returned
  291.  
  292.             USAGE
  293.  
  294.             MOUSECURSORDEFAULT defines the mouse cursor to be a small
  295.        ,K$╖┼╘╤░XQ)σ┤ö≡÷┴─┤àñT┘,╘¬àñX9╘⌠àñ\9╘UÜ╢≤`9╘4a╘d9╘UTa╘h9╘ta╘l9╘Uöa╘p9╘┤a╘t┘PT±x┴îÇ╖0▓ïα│ÅαU┤ôα╡ùα╢¢α╖úΓ╘pǺΓ╕¡αë ╚┴πì°sKÉφb<$⌡▌ë     φë φë I1φë  Eφë $YφÆë (mφë ,üφë 0$òφë á⌐φë ñ╜φë I¿╤φë ¼σφë ░∙φÆë 4
  296. ²ë ┤!²ë ╕$5²ë ╝I²ë └]²ë ⌐8q²ë <àⁿΦiǬ∙PÖÇ ¥Ç
  297. ⁿ
  298. ░╨â@%8@ΓΦá╝╤░≡cÑÅ*$
  299. ░╕≡ż≡τ╥m¿⌡ε    ╨@#µ≈$âh$âαra╨à`¥è∩Ç%Ç +─▀ TîcOî∩â°1<@  [$¿Ç¼ MMl·0ƒ Y¼─!%6a▐è ¥ì ßá+?±  P<îaTTV ╪iÇ¡≥░ `_ñ»%Çá᪠P█º»ε`éa∙É%H«┴íA%Gár∙É
  300. iw∙Éiφ`╧≥≡╤Çmⁿ▒
  301. ]ÆAáσw7░⌡∩    $·╟Ç√É&^`  ┐ $ⁿ  $■ $╒ nk$J-ÉQ1£PéBù »0αQ/Ñ4╜£░ºP≈Ñ4Ç⌡$(ª▀$@C]Æé≈└╕_SÇçÑ4=iÉ⌠ä╣<_np@Ñ45ò▒Y3ü¼Qí░.i>╠@5+┴╙É╛╙$@ #┴@«╦
  302. $╤
  303. #@Ñú4,p&e÷ü¼_ÇQºÑ4
  304. òQ  ü@;¡_áQ@e╠≥@mp!┤a╘O░√`Pñź ÇT°8ÿ!¼Åñ$½╙"q¿ PñCÇ¿α√└╥░eT"ß<p°%Pæ(╧%pδ¥/OêW0Ǽbφ φ B@[â¼8â≥µ≤(    ¿⌡%(Ç∩áTÿp+ óÜ▓0!Σ±(1±
  305. ░┤ÖÇD└D0Å╡`   $ «îO@╧1
  306. a╝╤j-0ñ│`@╖bΦaT1═⌠╝╤Σ²¼±,1öíî9lÿ28ÇÅ`Γî¿P²$,N0┴O0a╫δ≤0σú`°î╖#0δ≡└X▄1»Σî(▒¥Ç█Ñ"qá√1CÇú╟╨º Å
  307. FT Θ²î└1ÇY0    w ²à░$@AÅ`╦Φ¼╘`▄1A  }┐Ç*5 ΩSδδî`¼îaδæ¼î5 1¿⌡Ω╜⌠ ¼¥╬ü└Qî1S
  308. ╛≤î9╨iÇ,∙PU(}Ç$üÇ àÇ`σìÇ`QαÜBO$%ÿÇ╧"$Ç«Ç]É.┬\`%WÉ$  W0 ÄâO0]αG┬ur╩
  309. ░£▒
  310. Q¢ú╔Ç≡°s?`X0╘`@ µWâ@╣aá εdq`¥9?Ç&+o0µyÄΣAÅuV(7P╬±@IdQ╕@Å┤@;Ç▓?Çò│CÇ┤╟╨╡KÇÄ30ⁿφ° ó╬ì+]Ä╦≡     Mö╝σ ²y5<!└▀óâ╝É3~mp    $<╛≤9Æ-2ⁿ≡@T,╞Σa,)Pæ└¥#¼╪Q┤S(¼@Aîa
  311. ≡╤@Ö²±⌠KëD─┴▒▀0╨Ñ$╩-0 ╨ê*╙▓edm`î=3Kß-10è=≥≤²└£mîjy ÿe²ⁿ╨i╕e▓ΣmαÖ╢C%Ç*ê*0 EátQZ`mÄLP%    °üⁿªüNQ∙  T¿<qtWΩc z░ÅÇñΩçǪçÇ«;└<┐á¼¥. á?<Σscî)áí := 0;
  312.       end;
  313.     end;
  314.   end;
  315.   WaitToGo;
  316. end; { UserLineStylePlay }
  317.  
  318.  
  319. procedure SayGoodbye;
  320. { Say goodbye and then exit the program }
  321. var
  322.   ViewInfo : ViewPortType;
  323. begin
  324.   MainWindow('');
  325.   GetViewSettings(ViewInfo);
  326.   SetTextStyle(TriplexFont, HorizDir, 4);
  327.   SetTextJustify(CenterText, CenterText);
  328.   with ViewInfo do
  329.     OutTextXY((x2-x1) div 2, (y2-y1) div 2, 'That''s all folks!');
  330.   StatusLine('Press any key to quit...');
  331.   repeat until KeyPressed;
  332. end; { SayGoodbye }
  333.  
  334.  
  335. PROCEDURE SelectMode;
  336. VAR
  337.     choice1,choice2     : CHAR;
  338.    xsize,ysize            : WORD;
  339. BEGIN
  340.     (* Let's select a mode *)
  341.     ClrScr;
  342.     WriteLn('VESADEMO:');
  343.     WriteLn('1. 256 colors');
  344.     WriteLn('2. 32768 colors');
  345.     WriteLn('3. 65536 colors');
  346.     WriteLn('4. 16777216 colors');
  347.     WriteLn('Q uit');
  348.     WriteLn;
  349.     Write('Your choice: ');
  350.     REPEAT
  351.         ReadLn(choice1);
  352.       IF choice1 <> '1' THEN BEGIN
  353.           WriteLn('Sorry !');
  354.          WriteLn('This demo wasn''t written for more as 256 colors !');
  355.          WriteLn('You would only get a limited impression of the Hi-& TrueColor modes...');
  356.          WriteLn('Switching to 256 colors.');
  357.          choice1 := '1';
  358.       END;
  359.     UNTIL choice1 IN ['1'..'4','q'];
  360.     IF choice1 = 'q' THEN Halt;
  361.  
  362.     WriteLn;
  363.     WriteLn;
  364.     WriteLn('a. 320x200');
  365.     WriteLn('b. 640x480');
  366.     WriteLn('c. 800x600');
  367.     WriteLn('d. 1024x768');
  368.     WriteLn('e. 1280x1024');
  369.     WriteLn('Q uit');
  370.     WriteLn;
  371.     Write('Your choice: ');
  372.     REPEAT
  373.         ReadLn(choice2);
  374.     UNTIL choice2 IN ['a'..'e','q'];
  375.     IF choice2 = 'q' THEN Halt;
  376.  
  377.     CASE choice2 OF
  378.         'a' : BEGIN
  379.             xsize := 320;
  380.             ysize := 200;
  381.         END;
  382.         'b' : BEGIN
  383.             xsize := 640;
  384.             ysize := 480;
  385.         END;
  386.         'c' : BEGIN
  387.             xsize := 800;
  388.             ysize := 600;
  389.         END;
  390.         'd' : BEGIN
  391.             xsize := 1024;
  392.             ysize := 768;
  393.         END;
  394.         'e' : BEGIN
  395.             xsize := 1280;
  396.             ysize := 1024;
  397.         END;
  398.     END;
  399.     CASE choice1 OF
  400.         '1' : mode := FindVesaMode(xsize,ysize,8);
  401.         '2' : mode := FindVesaMode(xsize,ysize,15);
  402.         '3' : mode := FindVesaMode(xsize,ysize,16);
  403.         '4' : mode := FindVesaMode(xsize,ysize,24);
  404.     END;
  405.     IF mode = 0 THEN BEGIN
  406.         WriteLn('No such mode could be found !');
  407.         WriteLn('Switching to to 320x200.');
  408.         ReadKey;
  409.         mode := V320x200x256;
  410.     END;
  411. END;
  412.  
  413. begin { program body }
  414.   SelectMode;
  415.   Initialize;
  416.   ReportStatus;
  417.  
  418. {  AspectRatioPlay; }
  419.   FillEllipsePlay;
  420.   SectorPlay;
  421.   WriteModePlay;
  422.  
  423.   ColorPlay;
  424.   { PalettePlay only intended to work on these drivers: }
  425.   if (GraphDriver = EGA) or
  426.       (GraphDriver = EGA64) or
  427.       (GraphDriver = VGA) then
  428.      PalettePlay;
  429.   PutPixelPlay;
  430. {  PutImagePlay; }
  431.   RandBarPlay;
  432.   BarPlay;
  433.   Bar3DPlay;
  434.   ArcPlay;
  435.   CirclePlay;
  436.   PiePlay;
  437.   LineToPlay;
  438.   LineRelPlay;
  439. {  LineSty